home *** CD-ROM | disk | FTP | other *** search
- {
- Designer: Craig Ward
- Date: 6/9/95
-
- Function: Backup dialog. User specificies the source and destination directories,
- then the dialog will copy all files.
-
- Notes: The user selects which path to set via the radioGroup. However, there
- was a problem in that when the radioGroup index was changed, for some
- reason the label that was being de-activated as the directoryList's
- DirLabel, was still active.
-
- To overcome this I introduced a label, invisible at run-time, which
- acts as an intermediate between the changing of the directoryList's
- DirLabel.
- *********************************************************************************}
- unit Backup;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, StdCtrls, Buttons, FileCtrl, Gauges, ExtCtrls;
-
- type
- TBackupDlg = class(TForm)
- DirList: TDirectoryListBox;
- FList: TFileListBox;
- Label1: TLabel;
- lblSource: TLabel;
- Label2: TLabel;
- lblDestination: TLabel;
- btnOK: TBitBtn;
- btnCancel: TBitBtn;
- btnHelp: TBitBtn;
- Panel1: TPanel;
- Gauge1: TGauge;
- RGroup: TRadioGroup;
- lblInVisible: TLabel;
- procedure btnHelpClick(Sender: TObject);
- procedure btnCancelClick(Sender: TObject);
- procedure DirListChange(Sender: TObject);
- procedure FormActivate(Sender: TObject);
- procedure RGroupClick(Sender: TObject);
- procedure btnOKClick(Sender: TObject);
- private
- { Private declarations }
- procedure CopyFiles;
- public
- { Public declarations }
- end;
-
- var
- BackupDlg: TBackupDlg;
-
- implementation
-
- {$R *.DFM}
-
- uses
- LZExpand;
-
- {***Buttons*********************************************************************}
- {help}
- procedure TBackupDlg.btnHelpClick(Sender: TObject);
- begin
- Application.HelpCommand(HelpContext,btnHelp.HelpContext);
- end;
-
- {close}
- procedure TBackupDlg.btnCancelClick(Sender: TObject);
- begin
- close;
- end;
-
- {copy}
- procedure TBackupDlg.btnOKClick(Sender: TObject);
- begin
- CopyFiles;
- end;
-
- {***Directory list**************************************************************}
- procedure TBackupDlg.DirListChange(Sender: TObject);
- var
- i: integer;
- begin
- i := RGroup.ItemIndex;
- case i of
- 0:
- DirList.DirLabel := lblSource;
- 1:
- DirList.DirLabel := lblDestination;
- end;
- end;
-
- {***form preferences************************************************************}
- {on activation of the form, set the RGroup index}
- procedure TBackupDlg.FormActivate(Sender: TObject);
- begin
- RGroup.ItemIndex := 0;
- end;
-
- {***Radio group*****************************************************************}
- {intermediate step in changing directoryList's DirLabel}
- procedure TBackupDlg.RGroupClick(Sender: TObject);
- begin
- DirList.DirLabel := lblInVisible;
- end;
-
- {***Copy proc******************************************************************}
- procedure TBackupDlg.CopyFiles;
- var
- sLD,sS,sD: string;
- sI,dI,nI,pI: integer;
- begin
- {first, check paths}
- if CompareStr(lblSource.Caption,lblDestination.Caption) = 0 then
- begin
- messageDlg('Can not overwrite existing files',mtWarning,[mbOK],0);
- exit;
- end;
-
- {set desintation path string}
- sLD := lblDestination.Caption;
- {set directory-list to source path}
- DirList.Directory := lblSource.Caption;
-
- {calc progress to add to gauge}
- pI := 100 div (FList.Items.Count);
- Panel1.Visible := True;
-
- {init for loop}
- for nI := 0 to FList.Items.Count -1 do
- begin
- {set file names}
- sS := ExpandFileName(FList.Items.Strings[nI]);
- sD := sLD + '\' + ExtractFileName(FList.Items.Strings[nI]);
-
- {set file handles}
- sI := FileOpen(sS,0);
- dI := FileCreate(sD);
-
- {set buffer, execute, clear buffer}
- LZStart;
- CopyLZFile(sI,dI);
- LZDone;
-
- {close files}
- FileClose(sI);
- FileClose(dI);
-
- {update gauge}
- Gauge1.AddProgress(pI);
- Application.ProcessMessages;
- end;
- Panel1.Visible := False;
- end;
-
- {*******************************************************************************}
- end.
-